home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 4 / United Public Domain Gold 4.iso / fredfish / ff.0028.dms / ff.0028.adf / MileStone / polydraw.bas < prev   
BASIC Source File  |  1986-07-16  |  17KB  |  481 lines

  1. 5     clr:SCREEN 0,5:scnclr
  2. 10    DIM picture%(11000),regsave%(100),cset%(580),img1%(112),name$(19)
  3. 11    gosub 58000
  4. 12    vcset%=VARPTR(cset%(0)):vimg1%=VARPTR(img1%(0))
  5. 14    bload "polydraw_font",vcset%
  6. 20    filename$="polydraw_pic":x%=0:y%=0:gosub 17080
  7. 25    first%=11:last%=16:speed%=100:gosub 25070
  8. 30    scnclr
  9. 52    colorfile$="polydraw_reg_dat"
  10. 55    bload colorfile$,VARPTR(regsave%(0))
  11. 57    ct=0
  12. 59    FOR i% = 0 TO 31
  13. 61    rgb i%,regsave%(ct),regsave%(ct+1),regsave%(ct+2)
  14. 63    ct=ct+3
  15. 65    NEXT i%
  16. 70    pena 1:FLAG% = 0:COUNT%=0
  17. 90    a$="?":goto 180
  18. 100   REM **** MAIN LOOP ****
  19. 110   GET a$
  20. 120   IF a$="D" OR a$="d" OR a$="D." THEN GOSUB 12000:goto 1000
  21. 125   IF a$="Z" OR a$="z" OR a$="Z." THEN GOSUB 21000:goto 1000
  22. 130   IF a$="B" OR a$="b" OR a$="B." THEN GOSUB 10000:goto 1000
  23. 135   IF a$="X" OR a$="x" or a$="X." THEN GOSUB 40000:goto 1000
  24. 140   IF a$="L" OR a$="l" or a$="L." THEN GOSUB 11000:goto 1000
  25. 145   IF a$="O" OR a$="o" or a$="O." THEN GOSUB 35000:goto 1000
  26. 150   IF a$="S" OR a$="s" or a$="S." THEN GOSUB 15000:goto 1000
  27. 155   IF a$="F" OR a$="f" or a$="F." THEN GOSUB 14000:goto 1000
  28. 160   IF a$="C" OR a$="c" or a$="C." THEN GOSUB 13000:goto 1000
  29. 165   IF a$="K" OR a$="k" or a$="K." THEN GOSUB 17000:goto 1000
  30. 170   IF a$="Q" OR a$="q" or a$="Q." THEN GOTO 16000
  31. 175   IF a$="U" OR a$="u" or a$="U." THEN scnclr:goto 1000
  32. 180   IF a$="?" OR a$="/" OR a$="?." THEN GOSUB 30000:goto 120
  33. 185   IF a$="E" OR a$="e" or a$="E." THEN GOSUB 36000:goto 1000
  34. 187   IF a$="R" OR a$="r" or a$="R." THEN GOSUB 37000:goto 1000
  35. 188   IF a$="A" OR a$="a" or a$="A." THEN GOSUB 52000:goto 1000
  36. 190   IF a$="T" OR a$="t" THEN getkey b$:GOSUB 41000:goto 1000
  37. 192   if a$="TB" or a$="TS" then b$=mid$(a$,2,1):gosub 41000:goto 1000
  38. 200   IF a$="M" OR a$="m" or a$="M." THEN GOSUB 25000:goto 1000
  39. 500   GOTO 110
  40. 1000  for i%=1 to 10:get a$:next i%:goto 110
  41. 9999  REM **** RUBBER BAND BOX ****
  42. 10000 talk$ = TRANSLATE$("BOX!"):q% = narrate(talk$)
  43. 10005 GOSUB 10040
  44. 10016 IF a$<>"" THEN 20000
  45. 10030 GOTO 10005
  46. 10040 drawmode 2
  47. 10050 ask MOUSE x1%,y1%,b%:GOSUB 50000
  48. 10060 GOSUB 55000
  49. 10065 if a$<>"" then return
  50. 10070 x2% = x1% : y2% = y1%
  51. 10080 ask MOUSE x%,y%,b%:GOSUB 50000
  52. 10090 IF x% = x2% AND y% = y2% GOTO 10080
  53. 10100 IF b%=0 THEN 10150
  54. 10110 box (x1%,y1%;x2%,y2%)
  55. 10120 x2% = x% : y2% = y%
  56. 10130 box(x1%,y1%;x2%,y2%)
  57. 10140 IF b% <> 0 GOTO 10080
  58. 10150 drawmode 0
  59. 10155 peno colreg%:box(x1%,y1%;x2%,y2%)
  60. 10160 RETURN
  61. 10999 REM **** RUBBER BAND LINE ****
  62. 11000 talk$ = TRANSLATE$("LINE!"):q% = narrate(talk$)
  63. 11005 GOSUB 11040
  64. 11010 ask MOUSE x%,y%,b%:GOSUB 50000
  65. 11015 GET a$:IF a$="C" OR a$="c" THEN GOSUB 13000:GOTO 11010
  66. 11016 IF a$<>"" THEN 20000
  67. 11020 IF b% = 0 GOTO 11010
  68. 11030 GOTO 11005
  69. 11040 drawmode 2
  70. 11050 ask MOUSE x1%,y1%,b%:GOSUB 50000
  71. 11060 IF b% = 0 GOTO 11050
  72. 11070 x2% = x1% : y2% = y1%
  73. 11080 ask MOUSE x%,y%,b%:GOSUB 50000
  74. 11090 IF x% = x2% AND y% = y2% GOTO 11080
  75. 11100 IF b%=0 THEN 11150
  76. 11110 draw (x1%,y1% TO x2%,y2%)
  77. 11120 x2% = x% : y2% = y%
  78. 11130 draw (x1%,y1% TO x2%,y2%)
  79. 11140 IF b% <> 0 GOTO 11080
  80. 11150 drawmode 0
  81. 11155 draw (x1%,y1% TO x2%,y2%)
  82. 11160 RETURN
  83. 11999 REM **** DRAW ****
  84. 12000 talk$ = TRANSLATE$("DRAWW!"):q% = narrate(talk$)
  85. 12005 ask MOUSE x%,y%,b%:GOSUB 50000
  86. 12010 GET a$:IF a$ = "C" OR a$="c" THEN GOSUB 13000 ELSE IF a$<>"" THEN 20000
  87. 12020 IF b% = 0 GOTO 12005
  88. 12030 draw (x%,y%)
  89. 12035 ask mouse x%,y%,b%:gosub 50000
  90. 12036 if b%=0 goto 12005
  91. 12037 draw (to x%,y%)
  92. 12040 goto 12035
  93. 12999 REM **** COLOR CHANGE ROUTINE ****
  94. 13000 WINDOW #1,220,0,100,64,"COLORS "
  95. 13010 cmd #1
  96. 13015 ON ERROR GOTO 60010
  97. 13020 GOSUB 13500:GOSUB 13100
  98. 13030 ask MOUSE x5%,y5%,b5%
  99. 13040 IF b5%=0 THEN 13030
  100. 13050 colreg% = pixel (x5%,y5%)
  101. 13055 CLOSE #1:cmd #0:pena colreg%
  102. 13060 b%=0:GOTO 20000
  103. 13100 talk$ = TRANSLATE$("PICK A COLOR")
  104. 13110 q% = narrate (talk$)
  105. 13120 RETURN
  106. 13500 n% = 10
  107. 13510 FOR y%=0 TO 3
  108. 13520 FOR x%=0 TO 7
  109. 13530 pena x%+(8*y%)
  110. 13540 a% = x%*n%
  111. 13550 b% = y%*n%
  112. 13560 peno 1
  113. 13570 box(a%,b%;a%+n%,b%+n%),1
  114. 13580 NEXT x%,y%
  115. 13590 RETURN
  116. 13999 REM **** FILL ROUTINE ****
  117. 14000 talk$=TRANSLATE$("SELLECT A POINT, AND PRESS BUTTIN!"):q% = narrate(talk$)
  118. 14010 ask MOUSE x%,y%,b%:GOSUB 50000
  119. 14020 GET a$:IF a$="C" OR a$="c" THEN GOSUB 13000:GOTO 14010
  120. 14025 IF a$<>"" THEN 20000
  121. 14030 IF b%=0 THEN 14010
  122. 14040 PAINT (x%,y%),1
  123. 14050 GOTO 14010
  124. 14999 REM **** SAVE SCREEN ROUTINE ****
  125. 15000 REM
  126. 15010 i%=narrate("PLEY4S DHAX MAW3S AET DHAX TAA4P LEH4FT KOH4RNER",n%())
  127. 15020 ask MOUSE x1%,y1%,b%:x%=x1%:y%=y1%:GOSUB 50000
  128. 15022 gosub 55000:x3%=x1%:y3%=y1%
  129. 15025 IF a$<>"" THEN x1%=0:y1%=0:x2%=303:y2%=187:GOTO 15070
  130. 15040 i%=narrate("PLEY4S DHAX MAW3S AET DHAX BAA4TAHM RAY3T KOH4RNER",n%())
  131. 15050 ask MOUSE x2%,y2%,b%:x%=x2%:y%=y2%:GOSUB 50000
  132. 15060 gosub 56000:x1%=x3%:y1%=y3%
  133. 15065 drawmode 0
  134. 15070 ERASE picture%
  135. 15080 size% = INT(((x2%-x1%)/16)+2)
  136. 15090 size% = size%*(y2%-y1%)
  137. 15100 size% = ((((size%*5)+4)/2)+10)
  138. 15110 DIM picture%(size%)
  139. 15120 sshape (x1%,y1%;x2%,y2%),picture%()
  140. 15130 WINDOW #1,10,50,300,35,"   SAVE    "
  141. 15140 cmd #1:graphic 0
  142. 15150 PRINT "SIZE= ";size%:INPUT "Enter a Filename: ";filename$
  143. 15160 CLOSE #1:cmd #0:graphic 1
  144. 15165 IF filename$="" THEN 15400
  145. 15170 bsave filename$,VARPTR(picture%(0)),4*size%
  146. 15180 colorfile$=filename$+"_dat"
  147. 15190 ct=0
  148. 15200 FOR i%=0 TO 31
  149. 15210 ask rgb i%,red%,green%,blue%
  150. 15220 regsave%(ct)=red%:regsave%(ct+1)=green%:regsave%(ct+2)=blue%
  151. 15230 ct=ct+3
  152. 15240 NEXT i%
  153. 15250 bsave colorfile$,VARPTR(regsave%(0)),400
  154. 15400 GOTO 20000
  155. 15999 REM **** I QUIT ****
  156. 16000 talk$=TRANSLATE$("I QUIT!"):q% = narrate(talk$)
  157. 16010 SCREEN 0,4:rgb 15,0,0,0:END
  158. 16999 REM **** LOAD A SHAPE ****
  159. 17000 WINDOW #1,10,50,300,25,"    LOAD    "
  160. 17010 cmd #1
  161. 17020 INPUT "Enter a filename: ";filename$
  162. 17030 CLOSE #1:cmd #0
  163. 17035 IF filename$ = "" THEN 20000
  164. 17040 talk$=TRANSLATE$("PLACE POINTER WHERE YOU WANT PICTURE TO GO!")
  165. 17050 q% = narrate(talk$)
  166. 17060 ask MOUSE x1%,y1%,b%:GOSUB 50000
  167. 17062 gosub 55000:x%=x2%:y%=y2%:drawmode 0
  168. 17065 IF a$<>"" THEN x%=0:y%=0:GOTO 17080
  169. 17080 ERASE picture%:DIM picture%(11000)
  170. 17085 ON ERROR GOTO 60000
  171. 17090 bload filename$,VARPTR(picture%(0))
  172. 17100 gshape (x%,y%),picture%()
  173. 17110 colorfile$=filename$+"_dat"
  174. 17120 bload colorfile$,VARPTR(regsave%(0))
  175. 17130 ct=0
  176. 17140 FOR i%=0 TO 31
  177. 17150 rgb i%,regsave%(ct),regsave%(ct+1),regsave%(ct+2)
  178. 17160 ct=ct+3
  179. 17170 NEXT i%
  180. 17400 ON ERROR GOTO 0:GOTO 20000
  181. 20000 talk$ = TRANSLATE$("DONE?"):q% = narrate(talk$)
  182. 20005 drawmode 0
  183. 20010 ON ERROR GOTO 0:RETURN
  184. 20999 REM **** SHOW X & Y ****
  185. 21000 IF FLAG% = 0 THEN GOSUB 22000:RETURN
  186. 21010 FLAG% = 0:CLOSE #2:cmd #0:RETURN
  187. 22000 FLAG% = 1
  188. 22010 WINDOW #2,184,169,136,31," X & Y "
  189. 22030 cmd #0:RETURN
  190. 25000 talk$=TRANSLATE$("CYEKLE COLORS!"):q%=narrate(talk$)
  191. 25010 WINDOW #1,0,20,300,50,"  CYCLE COLORS   "
  192. 25020 cmd #1
  193. 25030 INPUT "Starting color register #: ";first%
  194. 25040 INPUT "Ending color register #:   ";last%
  195. 25050 IF first%>last% THEN GOTO 25030
  196. 25055 INPUT "Speed of rotation: ";speed%
  197. 25060 CLOSE #1:cmd #0
  198. 25070 ask rgb first%,r%,g%,b%
  199. 25080 FOR i%=last% TO first% STEP -1
  200. 25090 ask rgb i%,r1%,g1%,b1%
  201. 25100 rgb i%,r%,g%,b%
  202. 25110 r%=r1%:g%=g1%:b%=b1%
  203. 25120 ask MOUSE x%,y%,button%:IF button%=4 THEN GOTO 25200
  204. 25125 SLEEP(speed%)
  205. 25130 NEXT i%
  206. 25140 GOTO 25070
  207. 25200 ct=0
  208. 25210 FOR i% = 0 TO 31
  209. 25220 rgb i%,regsave%(ct),regsave%(ct+1),regsave%(ct+2)
  210. 25230 ct=ct+3
  211. 25240 NEXT i%
  212. 25250 GOTO 20000
  213. 29999 REM **** MENU ****
  214. 30000 WINDOW #1,0,0,190,187,"   MENU    "
  215. 30001 graphic 0:get a$:get a$
  216. 30002 cmd #1
  217. 30004 ? " "
  218. 30010 for i%=1 to 19:? name$(i%):next i%
  219. 30015 storey%=1
  220. 30020 ask mouse x%,y%,b%
  221. 30022 sleep (50000)
  222. 30025 if y%<8 or y%>160 or x%<0 or x%>150 then 30020
  223. 30030 cur%=int(y%/8):if cur%<1 or cur%>18 then 30045
  224. 30035 if cur%<>storey% then print at(0,storey%+1);name$(storey%);
  225. 30040 if cur%<>storey% then print at(0,cur%+1);inverse(1) name$(cur%);:storey%=cur%
  226. 30045 ask mouse x%,y%,b%
  227. 30050 if y%<8 or y%>152 or x%<0 or x%>150 then 30045
  228. 30054 if b%=4 then 30060
  229. 30055 goto 30030
  230. 30060 a$=mid$(name$(cur%),2,2)
  231. 30110 CLOSE #1:cmd #0:graphic 1:RETURN
  232. 34999 REM **** CIRCLE ****
  233. 35000 talk$ = TRANSLATE$("CIRCLE!"):q% = narrate(talk$)
  234. 35010 GOSUB 35070
  235. 35040 IF a$<>"" THEN 20000
  236. 35060 GOTO 35010
  237. 35070 drawmode 2
  238. 35080 ask MOUSE x1%,y1%,b%:GOSUB 50000
  239. 35090 gosub 55000
  240. 35095 if a$<>"" then return
  241. 35100 x2% = x1% : y2% = y1%
  242. 35110 ask MOUSE x%,y%,b%:GOSUB 50000
  243. 35120 IF x% = x2% AND y% = y2% GOTO 35110
  244. 35130 IF b%=0 THEN 35180
  245. 35140 CIRCLE (x1%,y1%),ABS(x2%-x1%)
  246. 35150 x2% = x% : y2% = y%
  247. 35160 CIRCLE (x1%,y1%),ABS(x2%-x1%)
  248. 35170 IF b% <> 0 GOTO 35110
  249. 35180 drawmode 0
  250. 35190 peno colreg%:CIRCLE (x1%,y1%),ABS(x2%-x1%)
  251. 35200 RETURN
  252. 35999 REM **** ELLIPSE ****
  253. 36000 talk$ = TRANSLATE$("ELIPSE!"):q% = narrate(talk$)
  254. 36010 GOSUB 36070
  255. 36040 IF a$<>"" THEN 20000
  256. 36060 GOTO 36010
  257. 36070 drawmode 2
  258. 36080 ask MOUSE x1%,y1%,b%:GOSUB 50000
  259. 36090 gosub 55000
  260. 36095 if a$<>"" then return
  261. 36100 x2% = x1% : y2% = y1%
  262. 36110 ask MOUSE x%,y%,b%:GOSUB 50000
  263. 36120 IF x% = x2% AND y% = y2% GOTO 36110
  264. 36130 IF b%=0 THEN 36180
  265. 36140 CIRCLE (x1%,y1%),ABS(x2%-x1%),ABS(y2%-y1%)/20
  266. 36150 x2% = x% : y2% = y%
  267. 36160 CIRCLE (x1%,y1%),ABS(x2%-x1%),ABS(y2%-y1%)/20
  268. 36170 IF b% <> 0 GOTO 36110
  269. 36180 drawmode 0
  270. 36190 peno colreg%:CIRCLE (x1%,y1%),ABS(x2%-x1%),ABS(y2%-y1%)/20
  271. 36200 RETURN
  272. 36999 REM **** RAYS ****
  273. 37000 talk$ = TRANSLATE$("RAYS!"):q% = narrate(talk$)
  274. 37010 GOSUB 37070
  275. 37020 ask MOUSE x%,y%,b%:GOSUB 50000
  276. 37030 GET a$:IF a$="C" OR a$="c" THEN GOSUB 13000:GOTO 37020
  277. 37040 IF a$<>"" THEN 20000
  278. 37050 IF b% = 0 GOTO 37020
  279. 37060 GOTO 37010
  280. 37070 drawmode 0
  281. 37080 ask MOUSE x1%,y1%,b%:GOSUB 50000
  282. 37090 IF b% = 0 GOTO 37080
  283. 37100 x2% = x1% : y2% = y1%
  284. 37110 ask MOUSE x%,y%,b%:GOSUB 50000
  285. 37120 IF x% = x2% AND y% = y2% GOTO 37110
  286. 37130 IF b%=0 THEN 37180
  287. 37140 draw (x1%,y1% TO x2%,y2%)
  288. 37150 x2% = x% : y2% = y%
  289. 37160 draw (x1%,y1% TO x2%,y2%)
  290. 37170 IF b% <> 0 GOTO 37110
  291. 37180 drawmode 0
  292. 37200 RETURN
  293. 40000 REM **** COPY SHAPE ****
  294. 40010 i%=narrate("PLEY4S DHAX MAW3S AET DHAX TAA4P LEH4FT KOH4RNER",n%())
  295. 40020 ask MOUSE x1%,y1%,b%:x%=x1%:y%=y1%:GOSUB 50000
  296. 40030 gosub 55000:x3%=x2%:y3%=y2%
  297. 40035 if a$<>"" then goto 40130
  298. 40040 i%=narrate("PLEY4S DHAX MAW3S AET DHAX BAA4TAHM RAY3T KOH4RNER",n%())
  299. 40050 ask MOUSE x2%,y2%,b%:x%=x2%:y%=y2%:GOSUB 50000
  300. 40060 gosub 56000:x1%=x3%:y1%=y3%
  301. 40065 drawmode 0
  302. 40070 ERASE picture%
  303. 40080 size% = INT(((x2%-x1%)/16)+2)
  304. 40090 size% = size%*(y2%-y1%)
  305. 40100 size% = ((((size%*5)+4)/2)+10)
  306. 40110 DIM picture%(size%)
  307. 40120 sshape (x1%,y1%;x2%,y2%),picture%()
  308. 40130 talk$=TRANSLATE$("SHAPE IS NOW READY TO USE!"):q% = narrate(talk$)
  309. 40140 ask MOUSE x%,y%,b%:GOSUB 50000
  310. 40150 GET a$:IF a$<>"" THEN 20000
  311. 40160 IF b%=0 THEN 40140
  312. 40170 gshape (x%,y%),picture%()
  313. 40180 GOTO 40140
  314. 41000 REM **** TEXT ROUTINE ****
  315. 41005 drawmode 0
  316. 41010 IF b$="B" OR b$="b" THEN GOSUB 41100
  317. 41020 IF b$="S" OR b$="s" THEN GOSUB 41500
  318. 41030 GOTO 20000
  319. 41100 talk$=TRANSLATE$("BIG TEXT!"):q%=narrate(talk$)
  320. 41110 ask MOUSE x%,y%,b%:GOSUB 50000
  321. 41115 gosub 55000:xo%=x1%:yo%=y1%-10:drawmode 0
  322. 41117 sleep(100000)
  323. 41120 GET alpha$:IF alpha$<>"" THEN IF ASC(alpha$)=13 THEN 41110
  324. 41121 if alpha$<>"" then if asc(alpha$)=227 or asc(alpha$)=195 then gosub 13000:alpha$=""
  325. 41125 if alpha$<>"" then gosub 42000
  326. 41128 ask mouse x%,y%,b%
  327. 41130 if b%=0 then 41120
  328. 41140 RETURN
  329. 41500 talk$=TRANSLATE$("SMALL TEXT!"):q%=narrate(talk$)
  330. 41510 graphic 1
  331. 41520 ask MOUSE x%,y%,b%:GOSUB 50000:graphic 1
  332. 41525 gosub 55000:x3%=x1%:y3%=y1%:drawmode 0
  333. 41526 sleep (100000)
  334. 41530 GET alpha$:IF alpha$<>"" THEN IF ASC(alpha$)=13 THEN 41520
  335. 41531 if alpha$<>"" then if asc(alpha$)=227 or asc(alpha$)=195 then gosub 13000:alpha$=""
  336. 41535 if alpha$<>"" then print at(x3%,y3%);alpha$:x3%=x3%+8
  337. 41538 ask mouse x1%,y1%,b%
  338. 41540 IF b%=0 THEN 41530
  339. 41550 graphic 0:RETURN
  340. 42000 REM plot alpha$ BIG
  341. 42020 sshape (xo%,yo%;12+xo%,yo%+12),img1%()
  342. 42030 soffset%=6:COLOR%=colreg%
  343. 42040 v%=vcset%+4+(ASC(alpha$)-32)*24
  344. 42050 WHILE COLOR%<>0
  345. 42060 IF (COLOR% MOD 2)=1 THEN FOR sk%=0 TO 23 STEP 4:POKE_l vimg1%+soffset%+sk%,PEEK_l(v%+sk%):NEXT
  346. 42070 COLOR%=INT(COLOR%/2)
  347. 42080 soffset%=soffset%+24
  348. 42090 WEND
  349. 42100 gshape (xo%,yo%),img1%()
  350. 42105 xo%=xo%+13
  351. 42110 RETURN
  352. 50000 IF FLAG% = 0 THEN RETURN
  353. 50010 COUNT% = COUNT% +1:IF COUNT% < 200 THEN RETURN
  354. 50020 COUNT% = 0:GOSUB 51000
  355. 50030 RETURN
  356. 51000 cmd #2:graphic 0:PRINT at(0,0);"X= ";:PRINT USING "###";x%;:PRINT "  Y= ";:PRINT USING "###";y%;
  357. 51010 cmd #0
  358. 51015 graphic 1
  359. 51020 RETURN
  360. 52000 WINDOW #1,0,0,320,200,"     R G B  MIXER      ":cmd #1
  361. 52010 graphic 1
  362. 52020 ask rgb colreg%,red%,green%,blue%
  363. 52030 pena colreg%: peno 1
  364. 52040 box(10,25;298,110),1
  365. 52050 RESTORE 52170
  366. 52060 FOR j%=1 TO 3
  367. 52070 READ a%,b%,c%
  368. 52080 pena a%
  369. 52090 AREA(c%+10,120 TO c%+0,130 TO c%+20,130)
  370. 52100 draw(c%+0,131 TO c%+20,131),1
  371. 52110 pena b%
  372. 52120 AREA(c%+0,135 TO c%+10,145 TO c%+20,135)
  373. 52130 draw(c%+0,134 TO c%+20,134),1
  374. 52140 pena 5
  375. 52150 AREA (c%+9,148 TO c%+9,163 TO c%+4,163 TO c%+10,166 TO c%+16,163 TO c%+11,163 TO c%+11,148)
  376. 52160 NEXT j%
  377. 52170 DATA 8,9,70,10,11,147,12,13,222
  378. 52180 GOSUB 52540:GOSUB 52620:GOSUB 52700
  379. 52190 CIRCLE (10,181),5:pena 2:PAINT (10,181),0
  380. 52200 pena 4:PRINT at(19,185); "= QUIT";
  381. 52210 n%=10:n1%=18
  382. 52220 FOR y%=0 TO 1
  383. 52230 FOR x%=0 TO 15
  384. 52240 pena x%+(16*y%)
  385. 52250 a% = (x%*n1%)+10
  386. 52260 b% = y%*n%
  387. 52270 peno 1
  388. 52280 box(a%,b%;a%+n1%,b%+n%),1
  389. 52290 NEXT x%,y%
  390. 52300 done% = 1
  391. 52310 WHILE done% = 1
  392. 52320 pena 6
  393. 52330 ask MOUSE x%,y%,button%
  394. 52340 IF button% = 4 AND y% < 20 THEN GOSUB 52720
  395. 52350 IF button% = 4 AND y% > 20 THEN GOSUB 52430
  396. 52360 WEND
  397. 52370 peno 0
  398. 52380 FOR i%=0 TO 93
  399. 52390 box(0+i%,0+i%;316-i%,187-i%),0
  400. 52400 SLEEP(5000)
  401. 52410 NEXT i%
  402. 52420 graphic 0:CLOSE #1:cmd #0:GOSUB 52780:RETURN
  403. 52430 colr% = pixel(x%,y%)
  404. 52440 IF colr% >= 8 AND colr% <= 13 THEN ON colr%-7 GOSUB 52480,52510,52560,52590,52640,52670
  405. 52450 SLEEP(100000)
  406. 52460 IF colr% = 2 THEN done% = 0
  407. 52470 RETURN
  408. 52480 REM *** inc. red ***
  409. 52490 red% = red% + 1:IF red% > 15 THEN red% = 15
  410. 52500 GOTO 52530
  411. 52510 REM *** dec. red ***
  412. 52520 red% = red% - 1:IF red% < 0 THEN red% = 0
  413. 52530 rgb colreg%,red%,green%,blue%
  414. 52540 pena 8:PRINT at((10+70)-7,180);:PRINT USING "##";red%
  415. 52550 RETURN
  416. 52560 REM *** inc. green ***
  417. 52570 green% = green% + 1:IF green% > 15 THEN green% = 15
  418. 52580 GOTO 52610
  419. 52590 REM *** dec. green ***
  420. 52600 green% = green% - 1:IF green% < 0 THEN green% = 0
  421. 52610 rgb colreg%,red%,green%,blue%
  422. 52620 pena 4:PRINT at((10+147)-7,180);:PRINT USING "##";green%
  423. 52630 RETURN
  424. 52640 REM *** inc. blue ***
  425. 52650 blue% = blue% + 1:IF blue% > 15 THEN blue% = 15
  426. 52660 GOTO 52690
  427. 52670 REM *** dec. blue ***
  428. 52680 blue% = blue% - 1:IF blue% < 0 THEN blue% = 0
  429. 52690 rgb colreg%,red%,green%,blue%
  430. 52700 pena 12:PRINT at((10+222)-7,180);:PRINT USING "##";blue%
  431. 52710 RETURN
  432. 52720 colreg% = pixel (x%,y%)
  433. 52730 pena colreg%:peno 1
  434. 52740 box(10,25;298,110),1
  435. 52750 ask rgb colreg%,red%,green%,blue%
  436. 52760 GOSUB 52540:GOSUB 52620:GOSUB 52700
  437. 52770 RETURN
  438. 52780 ct=0
  439. 52790 FOR i%=0 TO 31
  440. 52800 ask rgb i%,red%,green%,blue%
  441. 52810 regsave%(ct)=red%:regsave%(ct+1)=green%:regsave%(ct+2)=blue%
  442. 52820 ct=ct+3
  443. 52830 NEXT i%
  444. 52840 bsave colorfile$,VARPTR(regsave%(0)),400
  445. 52850 RETURN
  446. 55000 REM **** CROSS HAIR ****
  447. 55010 drawmode 2
  448. 55020 x2%=x1%:y2%=y1%
  449. 55030 draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%)
  450. 55040 ask MOUSE x%,y%,b%:GOSUB 50000
  451. 55045 get a$:if a$="C" or a$="c" then gosub 13000:drawmode 2:goto 55040
  452. 55046 if a$<>"" then b%=4
  453. 55050 IF b%<>0 THEN draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%):x1%=x2%:y1%=y2%:RETURN
  454. 55060 IF x%=x2% AND y%=y2% THEN 55040
  455. 55070 draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%)
  456. 55080 x2%=x%:y2%=y%
  457. 55090 draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%)
  458. 55100 GOTO 55040
  459. 56000 REM **** BOX SHADOW ****
  460. 56010 drawmode 2
  461. 56030 box (x1%,y1%;x2%,y2%)
  462. 56040 ask mouse x%,y%,b%:gosub 50000
  463. 56050 if b%<>0 then box (x1%,y1%;x2%,y2%):x2%=x2%+1:y2%=y2%+1:return
  464. 56060 if x%=x2% and y%=y2% then 56040
  465. 56070 box (x1%,y1%;x2%,y2%)
  466. 56080 x2%=x%:y2%=y%
  467. 56090 box (x1%,y1%;x2%,y2%)
  468. 56100 goto 56040
  469. 58000 restore 58050
  470. 58010 for i%=1 to 19:read name$(i%):next i%:return
  471. 58050 data " A... Alter Colors"," B... Box"," C... Change Color"," D... Draw"," E... Ellipse"," F... Fill"," K... Load"," L... Line"
  472. 58052 data " M... Cycle Colors"," O... Circle"," Q... Quit"," R... Rays"," S... Save"," TB.. Big Text"," TS.. Small Text"
  473. 58054 data " U... Clear Screen"," X... Copy Shape"," Z... Show X & Y"," ?... This Menu"
  474. 60000 RESUME 17400
  475. 60010 colreg%=1:talk$=TRANSLATE$("TRY AGAIN!"):q%=narrate(talk$)
  476. 60020 RESUME 13120
  477. 61000 scnclr
  478. 61010 get a$:if a$="" then 61010
  479. 61015 ? asc(a$);",";
  480. 61020 goto 61010
  481.